home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / UTTERM.f < prev   
Encoding:
Text File  |  1992-07-31  |  3.3 KB  |  90 lines
  1.       SUBROUTINE UTTERM 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *--- user total termination 
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'CLASS.h' 
  10.       include 'CURSTA.h' 
  11.       include 'FLWORK.h' 
  12.       include 'KEYCOM.h' 
  13.       include 'TYPDEF.h' 
  14.       include 'JOBSUM.h' 
  15.       include 'STATE.h' 
  16.       include 'FLAGS.h' 
  17.       include 'USIGNO.h' 
  18.       include 'USINFN.h' 
  19.       include 'CHECKS.h' 
  20.       LOGICAL BTEST 
  21.       CHARACTER*(MXNMCH) CNAM   
  22.       IF(UNFLP) RETURN  
  23.       WRITE(MPUNIT,500) 
  24.       DO 70 I=1,NGNAME  
  25.          NTYP = NAMTYP(IGNAME+I)
  26.          CNAM = SNAMES(IGNAME+I)
  27.          DO 10 IGN=1,NIGNOR 
  28.             IF(LIGNOR(IGN).NE.INDEX(CNAM,' ')-1)                 GOTO 10
  29.             IF(CIGNOR(IGN)(:LIGNOR(IGN)).EQ.CNAM(:LIGNOR(IGN)))  GOTO 70
  30.    10    CONTINUE   
  31. C check for use of obsolete CERN library routines   
  32.          IF(LCHECK(33).AND.(BTEST(NTYP,16).OR.BTEST(NTYP,14))) THEN 
  33.             CALL CHKOBS(CNAM,IWARN) 
  34.             IF(IWARN.NE.0) THEN 
  35.                WRITE(MPUNIT,560) CNAM   
  36.             ENDIF   
  37.          ENDIF  
  38.          IF(LCHECK(32).AND.BTEST(NTYP,7)) THEN  
  39. C sort common block names.  
  40.             DO 20 II=0,19   
  41.                IF(II.EQ.7)                                       GOTO 20
  42.                IF(BTEST(NTYP,II)) THEN  
  43.                   WRITE(MPUNIT,510) CNAM
  44.                ENDIF
  45.    20       CONTINUE
  46.          ENDIF  
  47.          IF(BTEST(NTYP,16)) THEN
  48. C FUNCTION  
  49.             ILEN = INDEX(CNAM,' ')-1
  50.                DO 30 INF=1,LIF  
  51.                   IF(INDEX(CINFUN(INF),' ')-1.EQ.ILEN) THEN 
  52.                      IF(CINFUN(INF).EQ.CNAM) THEN   
  53.                         IF(LCHECK(34).AND.BTEST(NTYP,11))   
  54.      &          WRITE(MPUNIT,520) CNAM  
  55.                                                                  GOTO 40
  56.                      ENDIF  
  57.                   ENDIF 
  58.    30          CONTINUE 
  59.             IF(LCHECK(35).AND..NOT.BTEST(NTYP,11)) WRITE(MPUNIT,530)
  60.      +      CNAM
  61.    40       CONTINUE
  62.          ENDIF  
  63. C Check for clashes between SUBROUTINE,BLOCKDATA,PROGRAM,ENTRY,FUNCTION 
  64.          IF(LCHECK(36)) THEN
  65.             DO 60 ITY=12,16 
  66.                IF(.NOT.BTEST(NTYP,ITY))                          GOTO 60
  67.                DO 50 ITY2=12,16 
  68.                   IF(ITY.EQ.ITY2)                                GOTO 50
  69.                   IF(.NOT.BTEST(NTYP,ITY2))                      GOTO 50
  70.                   WRITE(MPUNIT,540) CNAM
  71.                                                                  GOTO 70
  72.    50          CONTINUE 
  73.    60       CONTINUE
  74.          ENDIF  
  75.    70 CONTINUE  
  76.       WRITE(MPUNIT,550) 
  77.   500 FORMAT(/,1X,20('+'), ' BEGIN GLOBAL MODULE CHECKS   ',10('+'))
  78.   510 FORMAT(1X,'!!! WARNING ... VARIABLE ',A,  
  79.      +' IS NAME OF COMMON BLOCK AND OTHER') 
  80.   520 FORMAT(1X,'!!! WARNING ... FUNCTION ',A,  
  81.      +' IS EXTERNAL BUT CLASHES WITH INTRINSIC FUNCTION')   
  82.   530 FORMAT(1X,'!!! WARNING ... FUNCTION ',A,  
  83.      +' IS NOT INTRINSIC, AND IS NOT DECLARED "EXTERNAL"')  
  84.   540 FORMAT(1X,'!!! WARNING ... MODULE ',A,
  85.      +' HAS NAME CLASH WITH OTHER MODULE')  
  86.   550 FORMAT(1X,20('+'), ' END GLOBAL MODULE CHECKS     ',10('+'),//)   
  87.   560 FORMAT(1X,'!!! WARNING ... "',A,  
  88.      +'" IS OBSOLETE CERN LIBRARY ROUTINE') 
  89.       END   
  90.